      subroutine VmnpqVmnrs_to_Vpqrs_uri_vo(vmnpq, icore, symv1, 
     &            symv2, popm, popn, iopmn,
     &            popp, popq,ioppq,popr, pops, ioprs, 
     &            vpqrs, symv3, fact, fact2, 
     &            Vri1, Vri2, Vspin)
! this program is to calculate 
!   v(pq,rs)=fact2*v(pq,rs) + fact*v1(mn,pq)*v2(mn,rs). 
! symv1, symv2 and symv3 are the symmetry of vmnpq, vmnrs and vpqrs.
! one should not that
! the order of index in v1 and v2  must be like (mn,pq) and (mn,rs). this
! program can be employed to deal with iijkl, iijka and iabij. but for
! iabci and iabcd, the cost of memory would be very large so that some 
! special treatment must be employed.
!---if iopmn = 0, m<n,  1 m,n   2 m<=n    
!---if ioppq = 0, p<q,  1 p,q   2 p<=q
!---if ioprs = 0, r<s,  1 r,s   2 r<=s
!     
      use mod_ri
      use mod_size
      use mod_iop
      use mod_orbit
      use mod_ioff
      use mod_symm
      implicit none 
!
      integer, intent(in) :: symv1, symv2, symv3, vspin
      integer, intent(in) :: ioppq, iopmn, ioprs
      integer, intent(in) :: popp(8),popq(8),popr(8)
      integer, intent(in) :: pops(8),popm(8),popn(8)
      real*4, intent(in),managed :: vmnpq(*), icore(*)
      real*4, intent(in),managed :: vri1(*), Vri2(*)
      real*4, intent(inout),managed :: vpqrs(*)
      double precision, intent(in) :: fact, fact2
!
      integer inumpq(8), inumrs(8), inummn(8)
      integer inumpqi(8), inumrsi(8), inummni(8)
      integer iabsoff1(8), iabsoff3(8), iabsoff2(8)
      integer iabsoff1i(8), iabsoff3i(8), iabsoff2i(8)
      integer irr, irr1, irr2, irreps
      integer irrepr, irrepl, irrep, symv1i, symv3i
      integer irreppq, irreprs, irrepmn 
      integer irrepp, irrepq, irrepr1, irreps1, irrepm, irrepn
      integer numl, numr, ioffv1, ioffv2, ioffv3
      integer ioffcheck2(8), ioffcheck3(8) 
      integer nsize, nump, numq, numr1, nums, numm
      integer nummnr, irrepmnr, irreppqr
      integer numpqr, i1, i2, s, list, numpq, ioffout
      integer nreadr, ioffpqr
      integer, external :: idsymsz,irpdso, idsymsoc, isymoffso
      double precision, external :: dnrm2, nrm2so
!
! compute size of pq and rm for each irrep 
!
      if(ioprs==0) then 
          write(6,*)'error in vmnpqvmnrs_to_vpqrs_ri of ioprs', ioprs
          stop
      endif
      zorb(1) = 1; zorb(2:8) = 0 
      symv1i = dirprd(symv1, symrz)
      symv3i = dirprd(symv3, symrz)
      if(dirprd(symv1, symv2)/=symv3) then 
         write(6,*)'error of symmetry vmnpqvmnrs', symv1, symv2, symv3
         stop
      endif
      call izero(inumpq,8); call izero(inumrs,8)
      call izero(inummn,8); call izero(inumpqi, 8)
!-----inumpq
      
        do irrep=1, nirrep
           inumpq(irrep)  = irpdso(irrep, popp, popq, ioppq) 
        enddo
!-----inumrs
        do irrep=1, nirrep
              inumrs(irrep)  = irpdso(irrep, popr, pops, ioprs) 
        enddo
!-----inummn
        do irrep=1, nirrep
              inummn(irrep)  = irpdso(irrep, popm, popn, iopmn) 
        enddo
! compute absolute offsets to beginning of each irrep 
!---for vmnpq
      iabsoff1(1) = 1
      do irrepr = 1, nirrep-1
         irrepl = dirprd(irrepr, symv1)
         iabsoff1(irrepr+1) = iabsoff1(irrepr)
     &                 +inummn(irrepl)*inumpq(irrepr)*isd
      enddo
!---for vmnrs
      iabsoff2(1) = 1
      do irrepr = 1, nirrep-1
         irrepl = dirprd(irrepr, symv2)
         iabsoff2(irrepr+1) = iabsoff2(irrepr)
     &                 +inummn(irrepl)*inumrs(irrepr)*isd
      enddo
!---for vpqrs
      iabsoff3(1) = 1
      do irrepr = 1, nirrep-1
         irrepl = dirprd(irrepr, symv3)
         iabsoff3(irrepr+1) = iabsoff3(irrepr)
     &                 +inumpq(irrepl)*inumrs(irrepr)*isd
      enddo
!---for vpqrsi
      iabsoff3i(1) = 1 
      do irrepr = 1, nirrep-1
         irrepl = dirprd(irrepr, symv3i)
         iabsoff3i(irrepr+1) = iabsoff3i(irrepr)
     &                 +inumpqi(irrepl)*inumrs(irrepr)*isd
      enddo
      nsize = idsymsoc(1, vrta, vrta, 1, naux8, zorb, 1)
!      write(6,*)'nrm2so', nrm2so(nsize, vri1, 1)
      nsize = idsymsoc(1, vrta, popa, 1, naux8, zorb, 1)
!      write(6,*)'nrm2so', nrm2so(nsize, vri2, 1)


!---vmnpqvmnrs_to_vpqrs
      call printdnrm2('rivv', vri1, 111)
      call printdnrm2('rivo', vri2, 222)
      do irreps = 1, nirrep
         irrepmnr = dirprd(irreps, symv2) 
         nums = pops(irreps) 
         nummnr = idsymsoc(irrepmnr, popm, popn,iopmn, popr, zorb,1) 
         i1 = 1
         i2 = i1 + nummnr*isd
!---to calculate vmnpqvmnr_to_vpqr
!        write(6,*)' test vo here'
         do s = 1, nums 
!            write(6,*)'s', s, irreps, nummnr, vspin
!            write(6,*)'naux', iopmn, naux8
            call getpqrvo_ri2(icore, s, irreps, vri1, vri2, iopmn,vspin)
!            call getpqrvo_ri2_t(icore, s, irreps, vri1, vri2, 0, 1)
!            write(6,*)'norm of pqrvo', nrm2so(nummnr, icore, 1)
!---for r part 
            irreppqr = dirprd(irreps, symv3)
            numpqr = idsymsoc(irreppqr, popp, popq,ioppq, popr, zorb,1) 
            call VmnpqVmnrs_to_vpqrs(vmnpq, icore(i1), symv1, irrepmnr,
     &                   popm, popn, iopmn, popp, popq, ioppq, 
     &                   popr, zorb, 1, icore(i2), irreppqr, fact, 0.d0)
            ioffpqr=1
            do irrepr = 1, nirrep 
               numr = popr(irrepr)
               irreprs = dirprd(irrepr, irreps)
               irreppq = dirprd(irreprs, symv3) 
               numpq = irpdso(irreppq, popp, popq, ioppq) 
                  if(irrepr>irreps.and.ioprs/=1) cycle 
                  if(irrepr<irreps.or.ioprs==1) then 
                     ioffout = iabsoff3(irreprs) - 1 +  
     &              (isymoffso(irreps, irreprs, popr, pops, ioprs)-1
     &                 + (s-1)*numr)*numpq*isd + 1
                     nreadr= numr  
                  elseif(irrepr==irreps.and.ioprs==0) then 
                     ioffout = iabsoff3(irreprs) - 1 +  
     &              (isymoffso(irreps, irreprs, popr, pops, ioprs)-1
     &                 + (s-1)*(s-2)/2)*numpq*isd + 1
                     nreadr= s - 1
                  elseif(irrepr==irreps.and.ioprs==2) then
                     ioffout = iabsoff3(irreprs) - 1 +  
     &              (isymoffso(irreps, irreprs, popr, pops, ioprs)-1
     &                 + (s-1)*s/2)*numpq*isd + 1
                     nreadr= s 
                  endif
!              write(6,*)'ioffout', ioffout 
               call myicopyso(icore(i2-1+ioffpqr), vpqrs(ioffout), 
     &                           nreadr*numpq) 
               ioffpqr = ioffpqr + numpq*numr*isd
             enddo
          enddo
       enddo
!
      return
      end  



















 
